
open Format

module Int = struct                       
   type t = int
   let compare = Pervasives.compare
end

module ProcMap = Map.Make (Int)

let procs = ref ProcMap.empty

let fulltrace = ref []
let remtrace = ref []
let crit = ref []

let delete_event ev =
 GMain.Main.quit ();
 false

let set_pos () =
    let f k ((s, p):GSourceView2.source_view * int) =
    let i = s#source_buffer#get_iter (`LINE (p)) in
    let j = s#source_buffer#get_iter (`LINE (p+1)) in
    s#source_buffer#place_cursor ~where:i;
    ignore(s#scroll_to_iter ~use_align:true ~yalign:0.5 i);
(*    s#source_buffer#select_range i j;*)
(*    s#source_buffer#undo; *)
    let it_start = s#source_buffer#get_iter (`START) in
    let it_end = s#source_buffer#get_iter (`END) in
    s#source_buffer#remove_all_tags ~start:it_start ~stop:it_end;
    let color = match !crit with
      | [] | [_] -> "greenbg"
      | _ -> if List.mem s !crit then "redbg" else "greenbg"
    in
    s#source_buffer#apply_tag_by_name color ~start:i ~stop:j;
  in
  ProcMap.iter f !procs

let button_press btn =
  true

let step_clicked () =
  let e = begin match !remtrace with
  | [e] -> e
  | e :: l -> remtrace := l; e
  | [] -> ("", 1, [1])
  end in
  let (id, l, pl) = e in
  try
    let proc = List.hd pl in
    let (s, p) = ProcMap.find proc !procs in
    if id = "crit" then crit := s :: !crit;
    procs := ProcMap.add proc (s, l-1) !procs;
    set_pos ()
  with Failure _ -> ()

let restart_clicked () =
  remtrace := !fulltrace;
  crit := [];
  procs := ProcMap.map (fun (s, p) -> (s, 0)) !procs;
  set_pos ()

(* Main window *)
let window =
  GWindow.window
    ~title:"Trace"
    ~width:1280
    ~height:480
(*  ~width:640
    ~height:300 *)
    ~border_width:10 ()

(* Connect the delete event *)
let _ = window#event#connect#delete ~callback:delete_event

(* Main box used to display buttons in the upper part
  and the SourceView controls in the lower part *)
let vbox = GPack.vbox
  ~packing:window#add ()

(* Box containing the command buttons *)
let bbox = GPack.hbox
  ~packing:(vbox#pack ~from:`START) ()

(* The step button *)
let step = GButton.button
  ~label:"Step"
  ~packing:(bbox#pack ~from:`START) ()

(* Connect the clicked event for the step button *)
let _ = step#connect#clicked ~callback:(step_clicked)

(* The restart button *)
let restart = GButton.button
  ~label:"Restart"
  ~packing:(bbox#pack ~from:`START) ()

(* Connect the clicked event for the step button *)
let _ = restart#connect#clicked ~callback:(restart_clicked)

(* Main scrolled window, allowing to view SourceView controls *)
let scroll = GBin.scrolled_window 
  ~hpolicy:`AUTOMATIC
  ~vpolicy:`AUTOMATIC
  ~packing:vbox#add ()

(* Main container, will contain several SourceView controls *)
let box = GPack.table
  ~rows:1
  ~columns:2
  ~col_spacings:8
  ~homogeneous:true
  ~packing:scroll#add_with_viewport ()

let manager = GSourceView2.source_style_scheme_manager ~default:true

let schemes = Array.of_list manager#style_scheme_ids

let get_random_style_scheme () = 
(*
  Random.self_init (); 
  match manager#style_scheme schemes.(Random.int (Array.length schemes)) with 
  | None -> assert false 
  | some -> some 
*)
  match manager#style_scheme schemes.(2) with 
  | None -> assert false 
  | some -> some 

(* Build a SourceView control *)
let mk_source num file = 

  let scroll = GBin.scrolled_window 
    ~hpolicy:`AUTOMATIC
    ~vpolicy:`AUTOMATIC
    ~packing:(box#attach ~left:num ~top:0 ~fill:`BOTH) () in

  let src = GSourceView2.source_view 
    ~editable:false
    ~cursor_visible:false
    ~wrap_mode:`CHAR
    ~auto_indent:true 
    ~indent_on_tab:true
    ~indent_width:2 
    ~insert_spaces_instead_of_tabs:true 
    ~right_margin_position:80
    ~highlight_current_line:true
(*    ~show_line_marks:true *)
    ~show_line_numbers:true 
    ~show_right_margin:true
    ~width:550
    ~height: 400
    ~packing:scroll#add () in 

    ignore(src#event#connect#button_press ~callback:button_press);

    src#misc#modify_font_by_name "Monospace 10"; 

    ignore(src#source_buffer#create_tag ~name:"redbg" [`BACKGROUND "red"]);
    ignore(src#source_buffer#create_tag ~name:"greenbg" [`BACKGROUND "dark green"]);

    let buf = src#source_buffer in 

(*
let ocaml = 
  let manager = GSourceView2.source_language_manager ~default:true in 
  match manager#language "objective-caml" with 
  | None -> failwith "La coloration syntaxique pour OCaml n'est pas disponible !" 
  | some -> some
*)

(*  buf#set_language ocaml; *)

(*  buf#set_highlight_syntax true; *)
  buf#set_style_scheme (get_random_style_scheme ()); 

(*  buf#set_text (txt);*)
  let c = open_in file in begin try
    while true; do
      buf#insert ((input_line c) ^ "\n")
    done
  with End_of_file ->
    close_in c
  end;

  src



let run (trace, procnum) code =

  (* test *)
  (* printf "procnum : %d@\n" procnum; *)
  (* List.iter (fun (tr, line, l) -> *)
  (*   printf "line %d: " line; *)
  (*   List.iter (fun i -> printf "%i " i) l; *)
  (*   printf "\n" *)
  (* ) trace; *)

  fulltrace := trace;
  remtrace := trace;

  for i = 1 to procnum do
    procs := ProcMap.add i ((mk_source (i-1) code), 0) !procs
  done;

  let _ = set_pos () in

  (* Display the window. *)
  window#show ();

  (* Main loop *)
  GMain.Main.main ()
